(defun model-dialog () 

(let*((data-ob *current-data*)
      (data-matrix-column-list (column-list (send data-ob :active-data-matrix '(numeric category))))
      (labels (send data-ob :active-labels))
      (variables-list (send data-ob :active-variables '(numeric category)))
      (types (send data-ob :active-types '(numeric category)))
      (variables-list-num (iseq (length variables-list)))
      (length-list-items (if (> (length variables-list)) 100 (length variables-list 100)))
      (list-variables (send list-item-proto :new (combine variables-list (repeat "" length-list-items)) :columns 2))
      (list-variables-selected1 
       (send list-item-proto :new (repeat "" length-list-items) 
             ))
      (list-variables-selected2 (send list-item-proto :new (list "")))
      (list-results (send list-item-proto :new (repeat ""  length-list-items)))
      (operators-list (list "+" "-" "*" "/" "sum"))
      (operators (send choice-item-proto :new operators-list))
      (white (send text-item-proto :new ""))
      (res-variables)
      (num-variables (length variables-list))
      (go-right-button1 
       (send button-item-proto :new ">"
             :action #'(lambda () (let* ((selection (send list-variables :selection))
                                         ;(value (select (send list-variables :slot-value 'list-data) selection))
                                              (value (position "" (send list-variables-selected1 :slot-value 'list-data) 
                                                               :test #'equal))
                                         )
                                    (when 
                                     (and selection (not (equal value "")))
                                     
                                          (send list-variables-selected1 :set-text
                                                ; (send list-variables :selection)
                                                value
                                                (select (send list-variables :slot-value 'list-data)
                                                        (send list-variables :selection)))
                                     (send list-variables :set-text 
                                           (send list-variables :selection)
                                           "")
                                          (send list-variables :selection nil)
                                     
                                     )))))
      (go-left-button1 
       (send button-item-proto :new "<"
             :action #'(lambda () 
                         (let* ((selection (send list-variables-selected1 :selection))
                                (value (position 
                                        (select (send list-variables-selected1 :slot-value 'list-data) selection)
                                        variables-list :test #'equal))
                                     ;(value (position "" (send list-variables :slot-value 'list-data) 
                                                       ;                                :test #'equal))
                                )
                           (when 
                            (and selection (not (equal value "")))
                                 
                            (send list-variables :set-text
                                  ; (send list-variables-selected1 :selection)
                                  value
                                  (select (send list-variables-selected1 :slot-value 'list-data) 
                                          (send list-variables-selected1 :selection)))
                            (send list-variables-selected1 :set-text 
                                  (send list-variables-selected1 :selection)
                                  "")
                            (send list-variables-selected1 :selection nil)
                            
                            )))))
      (go-right-button2 (send button-item-proto :new ">"
                              :action #'(lambda () 
                                          (let* ((selection (send list-variables :selection))
                                                 ;(value (select (send list-variables :slot-value 'list-data) selection))
                                                 (value (position "" (send list-variables-selected2 :slot-value 'list-data) 
                                                                  :test #'equal))
                                                    )
                                            (when 
                                             (and selection (not (equal value "")))
                                             
                                             (send list-variables-selected2 :set-text
                                                   ; (send list-variables :selection)
                                                        value
                                                   (select (send list-variables :slot-value 'list-data)
                                                           (send list-variables :selection)))
                                             (send list-variables :set-text 
                                                         (send list-variables :selection)
                                                   "")
                                             
                                                  (send list-variables :selection nil)
                                             )))))
                                 
      (go-left-button2 (send button-item-proto :new "<"
                             :action #'(lambda () 
                                              (let* ((selection (send list-variables-selected2 :selection))
                                                     (value (position 
                                                             (select 
                                                              (send list-variables-selected2 
                                                                    :slot-value 'list-data) selection)
                                                             variables-list :test #'equal))
                                                     ;  (value (position "" (send list-variables :slot-value 'list-data) 
                                                                         ;                                  :test #'equal))
                                                     )
                                                (when 
                                                 (and selection (not (equal value "")))
                                                 (send list-variables :set-text
                                                       ; (send list-variables-selected2 :selection)
                                                       value
                                                       (select (send list-variables-selected2 :slot-value 'list-data)  
                                                               (send list-variables-selected2 :selection)))
                                                 (send list-variables-selected2 :set-text 
                                                       (send list-variables-selected2 :selection)
                                                       "")
                                                 (send list-variables-selected2 :selection nil)
                                                 )))))
      (OK (send button-item-proto :new "OK" 
                     :action #'(lambda () 
                                 (send (send ok :dialog) :close)
                                 (let* ((design-matrix-with-names
                                         (mapcar #'(lambda (el)
                                                     (cond 
                                                       ((listp el)
                                                        (let ((vars (mapcar #'(lambda (v) (coerce v 'list))
                                                                            (select data-matrix-column-list el)))
                                                              (is-factor (mapcar #'(lambda (l) 
                                                                                     (equal "CATEGORY" 
                                                                                            (string-upcase l)))
                                                                                 (select types el)))
                                                              (namebases (select variables-list el))
                                                              )
                                                          
                                                          (interaction vars
                                                                       :is-factor is-factor
                                                                       :namebases namebases)
                                                          ))
                                                       ((equal "CATEGORY" (string-upcase (select types el)))
                                                        (let ((var (coerce (select data-matrix-column-list el) 'list))
                                                              )
                                                          (factor  var
                                                                   :namebase (select variables-list el))
                                                          ))
                                                       ((equal "NUMERIC" (string-upcase (select types el)))
                                                        (let ((var (coerce (select data-matrix-column-list el) 'list))
                                                              (variable-name (select variables-list el))
                                                              )
                                                          (term var
                                                                :namebase variable-name))
                                                        )))
                                                 variables-list-num))
                                        
                                        (design-matrix (mapcar 'first design-matrix-with-names))
                                        (name-list (mapcar 'second design-matrix-with-names))
                                        (block-lengths (mapcar #'(lambda (dm) (if (listp dm) 1
                                                                                  (second (array-dimensions dm))))
                                                               design-matrix))
                                        
                                        (block-index (mapcar #'(lambda (i j) (iseq i (1- (+ i j))))
                                                             (combine 0 (butlast (cumsum block-lengths)))
                                                              block-lengths))
                                        (block-names variables-list)
                                        (model (regression-model 
                                                (column-list (apply 'bind-columns design-matrix))
                                                (normal-rand 76) ;for testing with cereals
                                                :predictor-names (combine name-list)))
                                        (cov (* (^ (send model :sigma-hat) 2)
                                                                             (send model :xtxinv)))
                                      
                                               
                                               )
                                   
                                   (mapcar #'(lambda (block-i block-n) (block-test block-i 
                                                                         (send model :coef-estimates)
                                                                         cov
                                                                         :names (cons "intercept" 
                                                                                      (send model :predictor-names))
                                                                         :block-name block-n
                                                                         :block-only t))
                                           block-index block-names)
                                       
                                                       
                                                                      
                                 ))))
      
      (add-variable (send button-item-proto :new "Add-variables" 
                          :action #'(lambda () 
                                      (let* (
                                      (operator-string "*")
                                             (operator (read-from-string operator-string))
                                      (n (length (first data-matrix-column-list)))
                                             (test (unless (= (length variables-list) 
                                                              (length (remove-duplicates variables-list :test #'equal)))
                                                           (error-message "There are two variables with the same name in this dataset. This may produce errors in the variables produced. Check carefully the results")))
                                             
                                             (group1 (mapcar #'(lambda (var) (position var variables-list :test #'equal))
                                                             (remove "" (coerce (send list-variables-selected1 
                                                                                      :slot-value 'list-data) 'list)
                                                       :test #'equal)))
                                             
                                             (group2 (mapcar #'(lambda (var) (position var variables-list :test #'equal))
                                                             (remove "" (coerce (send list-variables-selected2 
                                                                                      :slot-value 'list-data) 'list)
                                                                     :test #'equal)))
                                  
                                            ; (set1 (select data-matrix-column-list group1))
                                             
                                            ; (set2 (select data-matrix-column-list group2))
                                             
                                             (variables1 (select variables-list group1))
                                             (variables2 (select variables-list group2))
                                             
                                             )
                                       
                                      
                                          (when (> (length group1) 1)
                                                (let* ((name-var (introduce-symbol  
                                                                  variables1 "*"))
                                                       )
                                                  (setf variables-list-num2 
                                                        (append variables-list-num 
                                                                (list (remove-duplicates 
                                                                       (combine (select variables-list-num group1))
                                                                       :test '=))))
                                                  (when (> (length (remove-duplicates 
                                                                    (mapcar #'(lambda (v) 
                                                                                (if (listp v) 
                                                                                    (sort-data v)
                                                                                    v))
                                                                           variables-list-num2) :test 'equal))
                                                         (length variables-list-num))
                                                      (setf variables-list-num (copy-list variables-list-num2))
                                                      
                                                
                                                  (setf variables-list (combine variables-list name-var))
                                                  (setf num-variables (1+ num-variables))
                                                  
                                                  (mapcar #'(lambda (i name-var) 
                                                              (send list-variables :set-text i name-var)
                                                              (send list-variables-selected1 :set-text i "")
                                                              
                                                  )
                                                          (iseq num-variables) variables-list)
                                                  ))
                                        )))))
                          (cancel (send button-item-proto :new "Cancel" 
                                        :action #'(lambda () (send (send cancel :dialog) :close))))
      
      )
  
  (send dialog-proto :new (list 
                           (list (list list-variables)
                                   (list (list go-right-button1) 
                                         (list go-left-button1)) 
                                 (list list-variables-selected2 list-variables-selected1)
                                 ;(list operators )
                                 (list (list go-right-button2) 
                                       (list go-left-button2))
                                  ; (list list-variables-selected2)
                                 )
                           (list ok cancel add-variable)))
  
  ))
   